home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / dev / lang / amigatalk.lha / intuition / GadTools.st < prev    next >
Text File  |  2002-03-27  |  16KB  |  474 lines
  1. " --------------------------------------------------------------------- " 
  2. " GadTools class is the Parent class that interfaces AmigaTalk to the   "
  3. " gadtools.library in AmigaDOS.                                         "
  4. " --------------------------------------------------------------------- " 
  5.  
  6. Class GadTools :Glyph ! intuiMsgObj windowObj visualInfoObj !
  7. [
  8.    drawBoxFrom: sPoint to: ePoint tags: tagArray ! x y w h !
  9.       " This is a beveled box.  The tags will say whether it's recessed or not "
  10.       x <- sPoint x. " These are NOT checked against window boundaries "
  11.       y <- sPoint y.
  12.       w <- ePoint x.
  13.       h <- ePoint y.
  14.       
  15.       <primitive 239 2 windowObj x y w h tagArray>
  16. |
  17.    beginRefresh
  18.       <primitive 239 3 2 windowObj>
  19. |
  20.    endRefresh: completeFlag
  21.       <primitive 239 3 3 windowObj completeFlag> " completeFlag = true or false"
  22. |
  23.    getIMsg
  24.       ^ intuiMsgObj <- <primitive 239 3 4 windowObj>
  25. |
  26.    replyIMsg
  27.       <primitive 239 3 5 intuiMsgObj>
  28. |
  29.    replyIMsg: thisIntuiMsg
  30.       <primitive 239 3 5 thisIntuiMsg>
  31. |
  32.    getMessageClass: intuiMsgObject
  33.       ^ <primitive 239 3 10 intuiMsgObject>
  34. |
  35.    getMessageCode: intuiMsgObject
  36.       ^ <primitive 239 3 11 intuiMsgObject>
  37. |
  38.    getMessageQualifier: intuiMsgObject
  39.       ^ <primitive 239 3 12 intuiMsgObject>
  40. |
  41.    getMessageIAddress: intuiMsgObject
  42.       ^ <primitive 239 3 13 intuiMsgObject>
  43. |
  44.    getMessageMouseX: intuiMsgObject
  45.       ^ <primitive 239 3 14 intuiMsgObject>
  46. |
  47.    getMessageMouseY: intuiMsgObject
  48.       ^ <primitive 239 3 15 intuiMsgObject>
  49. |
  50.    getMessageSeconds: intuiMsgObject
  51.       ^ <primitive 239 3 16 intuiMsgObject>
  52. |
  53.    getMessageMicros: intuiMsgObject
  54.       ^ <primitive 239 3 17 intuiMsgObject>
  55. |
  56.    getGadgetType: intuiMsgObject
  57.       ^ <primitive 239 3 18 intuiMsgObject>
  58. |
  59.    refreshWindow
  60.       <primitive 239 3 6 windowObj>
  61. |
  62.    postFilterIMsg
  63.       ^ intuiMsgObj <- <primitive 239 3 7 intuiMsgObj>
  64. |
  65.    filterIMsg
  66.       ^ intuiMsgObj <- <primitive 239 3 8 intuiMsgObj>
  67. |
  68.    windowIs
  69.       ^ windowObj " Tell subclasses what Window they are attached to "
  70. |
  71.    registerTo: aWindowObject
  72.       ^ windowObj <- aWindowObject
  73. |
  74.    visualInfoObject
  75.       ^ visualInfoObj
  76. |
  77.    freeVisualInfo
  78.       <primitive 239 3 0 visualInfoObj>. 
  79.  
  80.       " visualInfoObj cannot be used after this unless you perform
  81.       * getVisualInfo:tags: again
  82.       "
  83.  
  84.       ^ visualInfoObj <- nil
  85. |
  86.    getVisualInfo: screenObj tags: tagArray
  87.       visualInfoObj <- <primitive 239 3 1 screenObj tagArray>.
  88.  
  89.       (visualInfoObj isNil)
  90.          ifTrue: [ 'ERROR: could NOT obtain visualInfo from screen!' print.
  91.                    ^ nil
  92.                  ].
  93.                  
  94.       ^ visualInfoObj
  95. ]
  96.  
  97. " --------------------------------------------------------------------- " 
  98. " NewGadgets Class is the class that interfaces AmigaTalk to the        "
  99. " new gadgets portion of gadtools.library                               "
  100. " --------------------------------------------------------------------- " 
  101.  
  102. Class NewGadgets :GadTools ! private gadgetList aNewGadgetObj windowObj !
  103. [
  104.    dispose
  105.       ^ nil
  106. |
  107.    disposeGadgetList: gadgetListObj
  108.       " Equivalent to FreeGadgets() from gadtools.library: "
  109.       <primitive 239 0 0 gadgetListObj>
  110. |
  111.    allocateGadgetList
  112.       ^ gadgetList <- <primitive 239 0 1>.
  113. |
  114.    createGadgetList
  115.       " Equivalent to CreateContext() from gadtools.library: "
  116.       ^ private <- <primitive 239 0 2 gadgetList>.
  117. |
  118.    disposeNewGadget: unNeededNewGadgetObj
  119.       " You will have to keep track of every newGadgetObj returned
  120.       * from makeNewGadget: & use this method on ALL of them 
  121.       * (unless you have memory to burn).  Once you've called
  122.       * addGadgetToList:type:tags:, a newGadgetObj is no longer
  123.       * needed & perhaps you should use this method afterwards:
  124.       "
  125.       <primitive 239 0 7 unNeededNewGadgetObj>.
  126.  
  127.       ^ nil
  128. |
  129.    makeNewGadget: structureArray ! desiredSize !
  130.       desiredSize <- 12.
  131.       
  132.       " structureArray is an Array Object with the following
  133.       * elements in the given order:
  134.       *   ele[1]  <- ng_LeftEdge,   ele[2]  <- ng_TopEdge,
  135.       *   ele[3]  <- ng_Width,      ele[4]  <- ng_Height,
  136.       *   ele[5]  <- ng_GadgetText, ele[6]  <- ng_TextAttr,
  137.       *   ele[7]  <- ng_GadgetID,   ele[8]  <- ng_Flags,
  138.       *   ele[9]  <- ng_VisualInfo, ele[10] <- ng_UserData
  139.       *
  140.       *   ele[11] <- NewGadget Type Tag
  141.       *   ele[12] <- HotKey or nil.
  142.       *
  143.       *   ele[10] (UserData) can be any AmigaTalk object 
  144.       *   but I recommend that you use a #methodSymbol.
  145.       *
  146.       *   ele[7] (GadgetID) should be a 16-Bit Integer value.
  147.       "
  148.       ^ aNewGadgetObj <- <primitive 239 0 3 structureArray desiredSize>
  149. |
  150.    newStructArray: initArray ! newArray !
  151.       " Example usage:
  152.       * gType        <- intuition getGadgetType: #BUTTON_KIND
  153.       * newGadget    <- NewGadgets new
  154.       * vi           <- newGadget visualInfoObject
  155.       * hotKey       <- $K
  156.       * newStruct    <- newGadget newStructArray: #( 10 40 100 20 'My _Gadget'
  157.       *                                              textAttrObj gadgetID 
  158.       *                                              myFlags vi
  159.       *                                              userData gType hotKey)
  160.       * newGadgetObj <- newGadget makeNewGadget: newStruct
  161.       "
  162.       newArray <- Array new: 12.
  163.       
  164.       newArray at: 1  put: (initArray at: 1).
  165.       newArray at: 2  put: (initArray at: 2).
  166.       newArray at: 3  put: (initArray at: 3).
  167.       newArray at: 4  put: (initArray at: 4).
  168.       newArray at: 5  put: (initArray at: 5).
  169.       newArray at: 6  put: (initArray at: 6).
  170.       newArray at: 7  put: (initArray at: 7).
  171.       newArray at: 8  put: (initArray at: 8).
  172.       newArray at: 9  put: (initArray at: 9).
  173.       newArray at: 10 put: (initArray at: 10).
  174.       newArray at: 11 put: (initArray at: 11).
  175.       newArray at: 12 put: (initArray at: 12).
  176.  
  177.       ^ newArray
  178. |
  179.    addGadgetToList: newGadgetObj at: gadgetObj type: gType tags: tagArray
  180.       " Equivalent to CreateGadgetA() from gadtools.library: "
  181.       ^ <primitive 239 0 4 gadgetObj newGadgetObj gType tagArray>
  182. |
  183.    setGadgetAttrs: gadgetObj with: tagArray
  184.       " Equivalent to GT_SetGadgetAttrsA() from gadtools.library: "
  185.       <primitive 239 0 5 gadgetObj windowObj tagArray>
  186. |
  187.    getGadgetAttrs: gadgetObj with: tagArray
  188.       " Equivalent to GT_GetGadgetAttrsA() from gadtools.library: "
  189.       ^ <primitive 239 0 6 gadgetObj windowObj tagArray>
  190. |
  191.    registerTo: aWindowObject
  192.       (aWindowObject isNil)
  193.          ifTrue: [ 'NewGadgets Object given a nil Window object!' print.
  194.                    ^ nil
  195.                  ].
  196.                  
  197.       ^ windowObj <- aWindowObject
  198. |
  199.    waitForGadgetValue ! rval !
  200.       " Use the returned Object (or copy it) BEFORE using any method 
  201.       * that uses <primitive 239 3 9 windowObj> again!
  202.       "
  203.       rval <- <primitive 239 3 9 windowObj>.
  204.       
  205.       ^ (rval at: 1)
  206. |
  207.    waitForGadgetUserData ! rval !
  208.       " Smalltalk code has to call this inside a loop if there
  209.       * is more than one IDCMP event expected.  You do NOT
  210.       * need to use beginRefresh or endRefresh arround this
  211.       * method.  Any AmigaTalk Object is valid as the
  212.       * UserData stored in the NewGadget.
  213.       *
  214.       * Use the returned Object (or copy it) BEFORE using any method 
  215.       * that uses <primitive 239 3 9 windowObj> again!
  216.       "
  217.       rval <- <primitive 239 3 9 windowObj>.
  218.       
  219.       ^ (rval at: 2)
  220. |
  221.    getUserData: intuiMsgObj
  222.       " User pressed a gadget, so get the User Data associated with it: "
  223.       ^ <primitive 239 0 8 intuiMsgObj>
  224. |
  225.    getGadgetID: intuiMsgObj
  226.       " User pressed a gadget, so get the GadgetID associated with it: "
  227.       ^ <primitive 239 0 9 intuiMsgObj>
  228. ]
  229.  
  230. " --------------------------------------------------------------------- " 
  231. " NewMenus Class is the class that interfaces AmigaTalk to the          "
  232. " new Menus portion of gadtools.library                                 "
  233. ""
  234. "   Making a menu: "
  235. ""
  236. "   menu <- NewMenus new "
  237. "   menu allocateNewMenu: 3 "
  238. "   menu1Array <- Array new: 6 "
  239. "   menu2Array <- Array new: 6 "
  240. "   intuition  <- Intuition new "
  241. ""
  242. "   menu1Array at: 1 put: (intuition getGadToolAttr: #NM_TITLE)"
  243. "   menu1Array at: 2 put: 'PROJECT' "
  244. "   menu1Array at: 3 put: 0  NO nm_CommKey for a Menu Title! "
  245. "   menu1Array at: 4 put: 0 "
  246. "   menu1Array at: 5 put: 0 "
  247. "   menu1Array at: 6 put: 0 "
  248. ""
  249. "   menu2Array at: 1 put: (intuition getGadToolAttr: #NM_ITEM)"
  250. "   menu2Array at: 2 put: 'Load a file..' "
  251. "   menu2Array at: 3 put: 'L' "
  252. "   menu2Array at: 4 put: 0 "
  253. "   menu2Array at: 5 put: 0 "
  254. "   menu2Array at: 6 put: 0 "
  255. ""
  256. "   menu fillNewMenuItem: 1 with: menu1Array "
  257. "   menu fillNewMenuItem: 2 with: menu2Array "
  258. ""
  259. "   You MUST have one of these for a valid menu strip: "
  260. "   menu fillNewMenuItem: 3 with: (menu endOfMenuArray: intuition) "
  261. ""
  262. "   chk1 <- menu createMenuStrip: tagArray1 -- CreateMenusA() tags apply here "
  263. "   chk2 <- initializeMenus: tagArray2      -- LayoutMenusA() tags apply here "
  264. " --------------------------------------------------------------------- " 
  265.  
  266. Class NewMenus :GadTools ! private newMenuArrayObj windowObj !
  267. [
  268.    disposeMenu
  269.       <primitive 239 1 0 private newMenuArrayObj>
  270. |
  271.    dispose               " Synonym for disposeMenu: "
  272.       self disposeMenu
  273. |
  274.    allocateNewMenu: numItems ! chk !
  275.       " newMenuArrayObj is an Array of NewMenu objects "
  276.  
  277.       chk <- <primitive 239 1 1 numItems>.
  278.  
  279.       (chk isNil)
  280.          ifTrue: [ 'Did NOT allocateNewMenu:' print].
  281.          
  282.       ^ newMenuArrayObj <- chk
  283. |
  284.    endOfMenuArray: intuitionObj ! endArray !
  285.       endArray  <- Array new: 6.
  286.  
  287.       endArray at: 1 put: (intuitionObj getGadToolAttr: #NM_END).
  288.       endArray at: 2 put: nil. " NO nm_Label        "
  289.       endArray at: 3 put: nil. " NO nm_CommKey      "
  290.       endArray at: 4 put: 0.   " NO nm_Flags        "
  291.       endArray at: 5 put: 0.   " NO nm_MutualExclude"
  292.       endArray at: 6 put: 0.   " NO nm_UserData     "
  293.  
  294.       ^ endArray
  295. |
  296.    xxxMakeArray: t k: k f: f x: ex data: data ! rval !
  297.       " See fileNewMenuItem comments: "
  298.  
  299.       rval <- Array new: 6.
  300.  
  301.       rval at: 2 put: t.
  302.       rval at: 3 put: k.
  303.       rval at: 4 put: f.
  304.       rval at: 5 put: ex.
  305.       rval at: 6 put: data.
  306.       
  307.       ^ rval
  308. |
  309.    initMenuArray: intObj title: title key: commKey flags: flags exclude: mx data: userData 
  310.       ! rval !
  311.       " Make a new Menu.  See fileNewMenuItem comments: "
  312.       rval <- self xxxMakeArray: title k: commKey f: flags x: mx data: userData.
  313.  
  314.       rval at: 1 put: (intObj getGadToolAttr: #NM_TITLE).
  315.       
  316.       ^ rval
  317. |
  318.    initMenuItemArray: intObj title: title key: commKey flags: flags exclude: mx data: userData 
  319.       ! rval !
  320.       " Make a new MenuItem.  See fileNewMenuItem comments: "
  321.       rval <- self xxxMakeArray: title k: commKey f: flags x: mx data: userData.
  322.  
  323.       rval at: 1 put: (intObj getGadToolAttr: #NM_ITEM).
  324.       
  325.       ^ rval
  326. |
  327.    initSubItemArray: intObj title: title key: commKey flags: flags exclude: mx data: userData 
  328.       ! rval !
  329.       " Make a new SubItem.  See fileNewMenuItem comments: "
  330.  
  331.       rval <- self xxxMakeArray: title k: commKey f: flags x: mx data: userData.
  332.  
  333.       rval at: 1 put: (intObj getGadToolAttr: #NM_SUB).
  334.       
  335.       ^ rval
  336. |
  337.    initMenuImageArray: intObj title: title key: commKey flags: flags exclude: mx data: userData
  338.       ! rval !
  339.       " Make a new MenuItem.  See fileNewMenuItem comments: "
  340.  
  341.       rval <- self xxxMakeArray: title k: commKey f: flags x: mx data: userData.
  342.  
  343.       rval at: 1 put: (intObj getGadToolAttr: #IM_ITEM).
  344.       
  345.       ^ rval
  346. |
  347.    initSubImageArray: intObj title: title key: commKey flags: flags exclude: mx data: userData
  348.       ! rval !
  349.       " Make a new SubItem.  See fileNewMenuItem comments: "
  350.  
  351.       rval <- self xxxMakeArray: title k: commKey f: flags x: mx data: userData.
  352.  
  353.       rval at: 1 put: (intObj getGadToolAttr: #IM_SUB).
  354.       
  355.       ^ rval
  356. |
  357.    fillNewMenuItem: itemNumber with: structureArray
  358.       " structureArray is an Array Object with the following
  359.       * elements in the given order:
  360.       * ele[1] <- nm_Type,          ele[2] <- nm_Label,
  361.       * ele[3] <- nm_CommKey,       ele[4] <- nm_Flags,
  362.       * ele[5] <- nm_MutualExclude, ele[6] <- nm_UserData 
  363.       *
  364.       * ele[6] is an Array as follows:
  365.       *
  366.       *    udele[1] <- userData (Usually a #methodSymbol,
  367.       *    udele[2] <- menu ID Integer or String,
  368.       *    udele[3] <- equivalent to ele[3] (nm_CommKey)
  369.       "
  370.       (<primitive 239 1 2 itemNumber structureArray newMenuArrayObj> ~= true)
  371.          ifTrue: [ self disposeMenu.
  372.                    'ERROR:  Could NOT fill a NewMenu entry!' print.
  373.                    ^ nil
  374.                  ] 
  375. |
  376.    createMenuStrip: tagArray ! chk !
  377.       chk <- <primitive 239 1 3 newMenuArrayObj tagArray>.
  378.       
  379.       (chk isNil)
  380.          ifTrue: [ 'Did NOT createMenuStrip:' print.
  381.                    ^ nil
  382.                  ].
  383.          
  384.       ^ private <- chk
  385. |
  386.    visualInfo
  387.       ^ (super visualInfoObject)
  388. |
  389.    initializeMenus: tagArray ! chk viObj !
  390.       " This method returns true if successful, false if the menus
  391.       * could NOT be laid-out, nil if there is an error condition.
  392.       "
  393.       viObj <- self visualInfo.
  394.       chk   <- <primitive 239 1 4 private viObj tagArray>.
  395.  
  396.       (chk ~= true)
  397.          ifTrue: [ 'Did NOT initialize NewMenus object!' print.
  398.                    ^ false
  399.                  ].
  400.       ^ true
  401. |
  402.    initializeMenus: viObj tags: tagArray ! chk !
  403.       " This method returns true if successful, false if the menus
  404.       * could NOT be laid-out, nil if there is an error condition.
  405.       "
  406.       chk   <- <primitive 239 1 4 private viObj tagArray>.
  407.  
  408.       (chk ~= true)
  409.          ifTrue: [ 'Did NOT initialize NewMenus object!' print.
  410.                    ^ false
  411.                  ].
  412.       ^ true
  413. |
  414.    waitForMenuString ! rval !
  415.       " Smalltalk code has to call this inside a loop if there
  416.       * is more than one IDCMP event expected.  You do NOT
  417.       * need to use beginRefresh or endRefresh arround this
  418.       * method.
  419.       *
  420.       * Use the returned Object (or copy it) BEFORE using any method 
  421.       * that uses <primitive 239 3 9 windowObj> again!
  422.       "
  423.       rval <- <primitive 239 3 9 windowObj>.
  424.       
  425.       ^ (rval at: 2)
  426. |
  427.    waitForMenuUserData ! rval !
  428.       " Smalltalk code has to call this inside a loop if there
  429.       * is more than one IDCMP event expected.  You do NOT
  430.       * need to use beginRefresh or endRefresh arround this
  431.       * method.  Make sure that you use only AmigaTalk Objects
  432.       * as the UserData stored in the NewMenu.  This method will
  433.       * return nil if the Menu Item selected was NULL.
  434.       *
  435.       * Use the returned Object (or copy it) BEFORE using any method 
  436.       * that uses <primitive 239 3 9 windowObj> again!
  437.       "
  438.       rval <- <primitive 239 3 9 windowObj>.
  439.       
  440.       ^ (rval at: 1)
  441. |
  442.    getMenuUserData: intuiMsgCode
  443.       " User selected a menu item, so return the User Data associated with it: "
  444.       ^ <primitive 239 1 5 windowObj intuiMsgCode>
  445. |
  446.    getMenuItem: intuiMsgCode
  447.       " Returns the MenuItem selected as an Object: "
  448.       ^ <primitive 239 1 6 windowObj intuiMsgCode>
  449. |
  450.    isMenuNull: intuiMsgCode
  451.       " check to see if the intuiMsgCode is MENUNULL, return true or false: "
  452.       ^ <primitive 239 1 7 private intuiMsgCode>
  453. |
  454.    getMenuNumber: intuiMsgCode
  455.       ^ <primitive 239 1 8 intuiMsgCode>
  456. |
  457.    getMenuItemNumber: intuiMsgCode
  458.       ^ <primitive 239 1 9 intuiMsgCode>
  459. |
  460.    getSubNumber: intuiMsgCode
  461.       ^ <primitive 239 1 10 intuiMsgCode>
  462. |
  463.    getFullMenuNumber: intuiMsgCode
  464.       ^ <primitive 239 1 11 intuiMsgCode>
  465. |
  466.    registerTo: aWindowObject
  467.       (aWindowObject isNil)
  468.          ifTrue: [ 'NewMenus Object given a nil Window object!' print.
  469.                    ^ nil
  470.                  ].
  471.                  
  472.       ^ windowObj <- aWindowObject
  473. ]
  474.